home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / basic / imb9107.zip / ISAMREPT.BAS < prev    next >
BASIC Source File  |  1991-07-12  |  8KB  |  143 lines
  1. DEFINT A-Z
  2. 'PROGRAM - ISAMREPT.BAS
  3.  
  4. '**********************************************************************
  5. '**     Purpose - This program creates an invoice report from        **
  6. '**               multiple tables in multiple ISAM databases         **
  7. '**********************************************************************
  8.  
  9. 'Initialize -----------------------------------------------------------
  10.  
  11. '$INCLUDE: 'ISAM.BI'
  12.  
  13. CONST True = -1, False = 0
  14. ' WIDTH ,43       'Uncomment this line if you have an EGA/VGA monitor
  15.                   '  to see the complete display on screen at one time
  16.  
  17. HdgA$ = "   Part#  Description             Price  Number   Amount"
  18. FmtA$ = "   \   \  \                    \  "
  19. FmtB$ = "###.##   ###    ###.##"
  20.  
  21. DIM Cust AS CustomerRec
  22. DIM IH AS InvoiceHeaderRec
  23. DIM IL AS InvoiceLineItemRec
  24. DIM Inven AS InventoryRec
  25.  
  26. CLS : PRINT "..ISAM Sample report from mulitiple tables"
  27.  
  28.  
  29. ' ===== Open tables and set the indexes ===============================
  30.  
  31. CustTbl = 1: IHTbl = 2: ILTbl = 3: InvenTbl = 4
  32.  
  33. OPEN "AR.MDB" FOR ISAM CustomerRec "CustTbl" AS CustTbl
  34. OPEN "AR.MDB" FOR ISAM InvoiceHeaderRec "InvHdrTbl" AS IHTbl
  35. OPEN "AR.MDB" FOR ISAM InvoiceLineItemRec "InvLineItemTbl" AS ILTbl
  36. OPEN "INVEN.MDB" FOR ISAM InventoryRec "InvenTbl" AS InvenTbl
  37.  
  38. SETINDEX CustTbl, "ByCustNbr"
  39. SETINDEX IHTbl, "ByCustNbr"
  40. SETINDEX ILTbl, "ByInvNbr"
  41. SETINDEX InvenTbl, "ByInvenNbr"
  42.  
  43.  
  44. '***************** M A I N   P R O G R A M   L O O P ******************
  45.                                                                      '*
  46. LastCustNbr$ = ""                    'Initialize signal value        '*
  47. MOVEFIRST IHTbl                      'Set position to first invoice  '*
  48. WHILE NOT EOF(IHTbl)                 'Process in Customer#/Invoice#  '*
  49.                                      '  order                        '*
  50.   RETRIEVE IHTbl, IH                                                 '*
  51.   IF LastCustNbr$ <> IH.CustNbr THEN 'New Customer                   '*
  52.     GOSUB GetNewCustomer                                             '*
  53.     GOSUB PrintCustomerHdg                                           '*
  54.     LastCustNbr$ = Cust.CustNbr      'Reset customer # signal value  '*
  55.   END IF                                                             '*
  56.   GOSUB PrintInvoiceHdr                                              '*
  57.   GOSUB PrintInvoiceLineItems                                        '*
  58.   MOVENEXT IHTbl                                                     '*
  59.                                                                      '*
  60. WEND                                                                 '*
  61. CLOSE CustTbl, IHTbl, ILTbl, InvenTbl                                '*
  62. END                                                                  '*
  63.                                                                      '*
  64. '**********************************************************************
  65.  
  66.  
  67.  
  68. GetNewCustomer: '------------------------------------------------------
  69.                                                                      '=
  70.   SEEKEQ CustTbl, IH.CustNbr          'Lookup customer name          '=
  71.                                                                      '=
  72.   IF NOT EOF(1) THEN                  'If customer ID found          '=
  73.     RETRIEVE CustTbl, Cust                                           '=
  74.   ELSE                                ' otherwise ID not found       '=
  75.     Cust.CustNbr = IH.CustNbr                                        '=
  76.     Cust.CompName = "Not listed in customer file"                    '=
  77.   END IF                                                             '=
  78.   RETURN                                                             '=
  79.                                                                      '=
  80. '======================================================================
  81.  
  82.  
  83. PrintCustomerHdg: '----------------------------------------------------
  84.                                                                      '=
  85.   PRINT : PRINT STRING$(70, "="): PRINT                              '=
  86.   PRINT " CustNbr: "; Cust.CustNbr; TAB(30);                         '=
  87.   PRINT "    Name: "; Cust.CompName                                  '=
  88.   RETURN                                                             '=
  89.                                                                      '=
  90. '======================================================================
  91.  
  92.  
  93. PrintInvoiceHdr: '-----------------------------------------------------
  94.                                                                      '=
  95.   PRINT : PRINT USING " Invoice: #####"; IH.InvNbr                   '=
  96.   PRINT HdgA$                                                        '=
  97.   RETURN                                                             '=
  98.                                                                      '=
  99. '======================================================================
  100.  
  101.  
  102. PrintInvoiceLineItems: '-----------------------------------------------
  103.                                                                      '=
  104.   Done = False                                                       '=
  105.   SEEKGE ILTbl, IH.InvNbr  'Find 1st line item if it exists          '=
  106.   WHILE NOT (Done OR EOF(ILTbl))                                     '=
  107.     RETRIEVE ILTbl, IL                                               '=
  108.     IF IL.InvNbr = IH.InvNbr THEN  'Make sure line item matches inv# '=
  109.       GOSUB LookupInventoryItem                                      '=
  110.       GOSUB PrintLineItem                                            '=
  111.       MOVENEXT ILTbl                                                 '=
  112.     ELSE                           'Line item does not belong to inv '=
  113.       Done = True  'Done with inv or no line items for inv number    '=
  114.     END IF                                                           '=
  115.   WEND                                                               '=
  116.   RETURN                                                             '=
  117.                                                                      '=
  118. '======================================================================
  119.  
  120.  
  121. LookupInventoryItem: '-------------------------------------------------
  122.                                                                      '=
  123.   SEEKEQ InvenTbl, IL.InvenNbr     'Look up inventory information    '=
  124.   IF EOF(InvenTbl) THEN                                              '=
  125.     Inven.Desc = "Item #" + IL.InvenNbr + " not listed"              '=
  126.   ELSE                                                               '=
  127.     RETRIEVE InvenTbl, Inven                                         '=
  128.   END IF                                                             '=
  129.   RETURN                                                             '=
  130.                                                                      '=
  131. '======================================================================
  132.  
  133.  
  134. PrintLineItem: '-------------------------------------------------------
  135.                                                                      '=
  136.   ExtendedAmount@ = IL.PriceEach * IL.NbrSold                        '=
  137.   PRINT USING FmtA$; IL.InvenNbr; Inven.Desc;                        '=
  138.   PRINT USING FmtB$; IL.PriceEach; IL.NbrSold; ExtendedAmount@       '=
  139.   RETURN                                                             '=
  140.                                                                      '=
  141. '======================================================================
  142.  
  143.